home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fritz: All Fritz
/
All Fritz.zip
/
All Fritz
/
FILES
/
EDUCLING
/
SPELLBEE.LZH
/
BACH2.BAS
< prev
next >
Wrap
BASIC Source File
|
1984-01-08
|
9KB
|
169 lines
10 REM *******************************************
15 REM * BASIC COMPOSER (BACH TO BASIC) 1.2 *
20 REM * by *
25 REM * PERRY LEOPOLD *
30 REM * *
35 REM * copyright 1983 PERRY LEOPOLD *
40 REM * all rights reserved *
45 REM *******************************************
50 CLEAR:KEY OFF:CLS:WIDTH 80:COLOR 15,5,14
55 QY=1:CL=1
60 QZ=0
65 LOCATE 10,15:INPUT "DO YOU WANT TO WORK ON A SONG YOU HAVE SAVED";X$
70 IF X$="Y" OR X$="y" THEN CLS:COLOR 15,2,14:LOCATE 10,20:INPUT "WHAT IS THE NAME OF THE SONG";C$ ELSE GOTO 85
75 OPEN "I",1,C$:INPUT #1,B$,EEEE$,EEE$,EE$,E$,AX$,T$:CLOSE:CX=1
80 GOSUB 570:GOTO 95
85 CLS:LOCATE 12,20:PRINT "WHAT DO YOU WANT TO CALL YOUR SONG"
90 LOCATE 16,28:COLOR 14,1,15:INPUT;B$
95 CLS
100 IF X$="N" OR X$="n" THEN E$="" ELSE E$=E$+AX$:GOSUB 310
105 CT=1
110 LOCATE 25,20:COLOR 15,4:PRINT "ENTER A ? FOR A LIST OF MORE OPTIONS"
115 LOCATE 1,26:COLOR 31,5,15:PRINT B$
120 FOR L=2 TO 10
125 LOCATE L,1:COLOR 14,4:PRINT TAB(80)
130 NEXT L
135 LOCATE 2,1:COLOR 14,1:GOSUB 585
140 FOR S=1 TO 5
145 LOCATE S+12,1:COLOR 15,3:PRINT "|_____________________________________________________________________________|"
150 NEXT
155 IF CT>1 THEN X$="Y":GOTO 240
160 IF X$="y" THEN X$="Y"
165 IF CX=1 OR AX$="X" THEN LOCATE 1,1:COLOR 15,0:PRINT "PARAMETERS="T$
166 IF CX=1 OR AX$="X" THEN LOCATE 22,15:COLOR 15,2:INPUT "DO YOU WANT TO CHANGE THE SONG'S PARAMETERS";XP$
170 IF XP$="Y" OR XP$="y" THEN GOTO 180
175 IF CX=1 THEN LOCATE 1,1:COLOR 15,0:PRINT "PARAMETERS="T$:CX=2:GOTO 240
180 LOCATE 22,1:COLOR 15,1:PRINT TAB(80)
181 LOCATE 22,17:INPUT "SET YOUR TEMPO <32=slowest / 255=fastest>";R$:S$="T":RS$=S$+R$
185 IF R$="?" THEN AX$="?":GOTO 490
190 LOCATE 22,1:COLOR 15,1:PRINT TAB(80)
191 LOCATE 22,7:INPUT "PICK WHAT OCTAVE THE SONG SHOULD START AT <1=lowest / 7=highest>";O$:P$="O":OP$=P$+O$
195 IF O$="?" THEN AX$="?":GOTO 490
200 TS=VAL(R$):TP=VAL(O$)
205 IF CX=2 THEN T$=T$ ELSE T$=RS$+OP$
210 ON ERROR GOTO 670
215 IF TS<32 OR TS>255 THEN ERROR 210
220 IF TP<1 OR TP>7 THEN ERROR 210
225 LOCATE 1,1:COLOR 15,1:PRINT TAB(18):LOCATE 1,1:COLOR 15,0:PRINT "OCTAVE="OP$:LOCATE 1,71:PRINT "TEMPO="RS$
230 REM 'ENTER NEW NOTES
235 REM '
240 GOSUB 395
245 LOCATE 12,2:PRINT EEEE$ EEE$ EE$ E$:LOCATE 19,1,1,7,0:COLOR 15,1:INPUT "ENTER NOTES";AX$
250 CT=CT+1:CL=CL+1
255 IF AX$="X" OR AX$="x" THEN GOTO 180
260 IF AX$="R" OR AX$="r" THEN F$="Y":GOSUB 570
265 IF AX$="@" THEN GOTO 450
270 IF AX$="?" THEN GOTO 490
275 IF AX$="*" THEN GOTO 545
280 IF AX$="0" THEN GOSUB 685:END
285 ON ERROR GOTO 650
290 LOCATE 15,3:PRINT AX$:PLAY T$+AX$:GOSUB 640 'CHANGE SUBROUTINE
295 IF CL=2 THEN CL=1:GOSUB 310
300 IF CT=2 THEN GOSUB 565
305 GOTO 140
310 W=1
315 IF LEN(EEEE$)+LEN(EEE$)<256 THEN EEEE$=EEEE$+EEE$:EEE$=""
320 IF LEN(EEE$)+LEN(EE$)<256 THEN EEE$=EEE$+EE$:EE$=""
325 IF LEN(EE$)+LEN(E$)<256 THEN EE$=EE$+E$:E$=""
330 AL=255-(LEN(E$))
335 BL=255-(LEN(EE$))
340 CL=255-(LEN(EEE$))
345 DL=255-(LEN(EEEE$))
350 LET B=(LEN(E$))-BL
355 LET C=(LEN(EE$))-BL
360 LET D=(LEN(EEE$))-BL
365 IF LEN(EEEE$)<255 AND (LEN(EEEE$)+LEN(EEE$))>255 THEN EEEE$=EEEE$+LEFT$(EEE$,DL):EEE$=RIGHT$(EEE$,D)
370 IF LEN(EEE$)<255 AND (LEN(EEE$)+LEN(EE$))>255 THEN EEE$=EEE$+LEFT$(EE$,CL):EE$=RIGHT$(EE$,C)
375 IF LEN(EE$)<255 AND (LEN(EE$)+LEN(E$))>255 THEN EE$=EE$+LEFT$(E$,BL):E$=RIGHT$(E$,B)
380 W=W+1:IF W<4 THEN GOTO 315
385 RETURN
390 RETURN
395 COLOR 15,1:LOCATE 18,1:PRINT TAB(80)
400 QZ=QZ+.66
405 QY=QY+2.66
410 IF QY>8 THEN QY=QY-QZ
415 IF QY<0 THEN QY=QY+2(QZ)
420 FOR Q=19 TO 24
425 QQ=(Q-18)+QY
430 LOCATE Q,1:COLOR 15,QQ:PRINT TAB(80)
435 NEXT Q
440 IF QZ>8 THEN QZ=1
445 RETURN
450 IF AX$="@" THEN LOCATE 19,1:PRINT TAB(80):ELSE RETURN
451 LOCATE 19,16:INPUT "HOW MANY TIMES DO YOU WANT THE SONG TO REPEAT";YZ
455 IF YZ>300 THEN GOTO 480
460 XYZ=1
465 LOCATE 21,1:PRINT TAB(80)
470 LOCATE 21,35:PRINT XYZ:PLAY T$+EEEE$:PLAY EEE$:PLAY EE$:PLAY E$:XYZ=XYZ+1
475 IF XYZ<YZ+1 THEN GOTO 470 ELSE GOTO 240
480 FOR J=18 TO 24
485 LOCATE J,1:PRINT TAB(80):NEXT J
486 LOCATE 21,4:PRINT "ARE YOU NUTS??? I'M NOT GOING TO REPEAT THIS THING"YZ"TIMES...TRY AGAIN!":GOTO 450
490 IF AX$="?" THEN LOCATE 19,1:PRINT TAB(80) ELSE RETURN
495 FOR J=18 TO 24
500 LOCATE J,1:PRINT TAB(80):NEXT J
505 LOCATE 18,13:PRINT "--- ENTER ANY OF THE FOLLOWING OPTIONS AT THE PROMPT ---"
510 LOCATE 20,11:PRINT "0 = SAVE SONG X = CHANGE OCTAVE/TEMPO SETTINGS "
515 LOCATE 21,11:PRINT "R = REPEAT SONG @ = REPEAT SONG X NUMBER OF TIMES"
520 LOCATE 22,11:PRINT "* = DISPLAY SONG & CLEAR MEMORY FOR RE-WRITING FROM BEGINNING"
521 LOCATE 23,1:INPUT "ENTER YOUR CHOICE";AX$
525 IF AX$="?" THEN LOCATE 19,11:COLOR 15,0:PRINT " THAT'S ALL SHE WROTE...PLEASE ENTER YOUR CHOICE "
526 IF AX$="?" THEN GOTO 510
530 FOR J=18 TO 24
535 LOCATE J,1:PRINT TAB(80):NEXT J
540 IF R$="?" OR O$="?" THEN GOTO 180 ELSE GOTO 250
545 IF AX$="*" THEN LOCATE 13,1:PRINT EEEE$ EEE$ EE$ E$:EEEE$="":EEE$="":EE$="":E$="":GOTO 240
550 REM '
555 REM 'REPEAT SONG REQUEST
560 REM '
565 IF AX$="R" THEN RETURN
570 IF F$="Y" OR X$="Y" THEN COLOR 15,1:LOCATE 20,25:PRINT "OK...HEAR GOES "B$"... "
571 IF F$="Y" OR X$="Y" THEN LOCATE 12,2:PRINT EEEE$" ":PRINT EEE$" ":PRINT EE$" ":PRINT E$
572 IF F$="Y" OR X$="Y" THEN PLAY T$+EEEE$:PLAY EEE$:PLAY EE$:PLAY E$:LOCATE 20,1:COLOR 15,4:PRINT TAB(80)
575 IF AX$="R" OR AX$="r" THEN AX$=""
580 RETURN
585 PRINT "--Possible Notes and Values--Rests--Octaves--------Tempo---------Misc. Syntax
590 PRINT "| A A- A+ | 1 = Whole = P1 | O7 high | T255 (fastest) | MS = staccato
595 PRINT "| B B- -- | 2 = 1/2 = P2 | O6 ^ | ^ | ML = legato
600 PRINT "| C -- C+ | 4 = 1/4 = P4 | O5 ^ | ^ | L # = length
605 PRINT "| D D- D+ | 8 = 1/8 = P8 | O4 mid C | T120 (medium) | . = dot note
610 PRINT "| E E- -- | 16 = 1/16 = P16| O3 ^ | ^ | N # plays any
615 PRINT "| F -- F+ | 32 = 1/32 = P32| O2 ^ | ^ |of the 84 notes
620 PRINT "| G G- G+ | 64 = 1/64 = P64| O1 low | T32 (slowest) | N 0 = rest
625 PRINT " "
630 PRINT " Ex: 3 Blind Mice = E D C /fast= T190 EDC or E16 D16 C16 /slow=T40 E1 D1 C1":RETURN
635 PRINT " "
640 IF AX$="R" THEN AX$="":GOTO 245
641 LOCATE 19,1:COLOR 15,1:PRINT TAB(80)
642 LOCATE 19,15:COLOR 15,2:INPUT "DO YOU WANT TO CHANGE WHAT YOU JUST HEARD (Y/N)";L$
643 LOCATE 19,1:COLOR 15,4:PRINT TAB(80)
645 IF L$="Y" OR L$="y" THEN GOTO 245 ELSE E$=E$+AX$:RETURN
650 IF ERR=5 THEN FOR J=19 TO 24:LOCATE J,1:COLOR 15,4:PRINT TAB(80):NEXT J ELSE GOTO 660
651 LOCATE 22,2:PRINT "Uh oh...You goofed! All numbers must come AFTER the notes...and 0 is not O."
655 LOCATE 23,3:PRINT "By the way...B+, C-, E+, and F- can't be used. They don't musically exist.":RESUME 245
660 IF ERR=15 THEN FOR J=19 TO 24:LOCATE J,1:PRINT TAB(80):NEXT J ELSE GOTO 665
661 LOCATE 22,8:COLOR 15,4:PRINT "Oops...You can only enter so many notes at a time...Try it again...":RESUME 245
665 IF ERL=280 THEN GOSUB 685:END
670 IF ERR=210 THEN LOCATE 19,5:PRINT "You goofed...Be careful not to exceed the Octave and Tempo parameters."
675 IF ERL=215 THEN RESUME 180
680 IF ERL=220 THEN RESUME 190
685 LOCATE 22,23:COLOR 15,2:INPUT "DO YOU WANT TO SAVE THIS SONG";XX$
690 IF XX$="Y" THEN LOCATE 22,20:INPUT "DO YOU WANT TO CHANGE THE SONG'S NAME";XZ$
695 IF XZ$="Y" OR XZ$="y" THEN LOCATE 22,1:PRINT TAB(80):LOCATE 22,20:INPUT "WHAT WILL IT BE CALLED";B$
700 IF AX$="0" THEN AX$=" "
705 IF XX$="Y" THEN OPEN "O",1,B$:PRINT #1,B$;",";EEEE$;",";EEE$;",";EE$;",";E$;",";AX$;",";T$:CLOSE ELSE RETURN
706 LOCATE 24,20:COLOR 15,4:PRINT "REMEMBER --- YOUR SONG IS CALLED <"B$">"
710 END
715 REM ' This program was designed to run on advanced basic (BASICA) and was
720 REM ' meant to be run on 80 column color moniters. Modifications for 40
725 REM ' column moniters are simple enough. If your version of BASIC does not
730 REM ' support PLAY statements, those program lines may be modified to SOUND
735 REM ' statements. A data subroutine can then be included which will serve
740 REM ' as a table of frequency. Durations may be entered individually or
745 REM ' assigned variables.
750 REM '
755 REM ' Feedback is welcomed. Write to us c/o PAN, P.O. Box 454, Skippack,
760 REM ' PA 19474. Source: STX453 / Compuserve: 70176,620 / Delphi: PAN
765 REM '
770 REM ' MAY THE SCORES BE WITH YOU...